home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / SM / SMPrefs / IDCMP.PAS next >
Pascal/Delphi Source File  |  1996-03-26  |  16KB  |  571 lines
  1. Procedure InfoGadFunc;
  2.  
  3. VAR
  4.     ret : LONG;
  5.     tgs : Array[0..5] of LONG;
  6.     
  7. begin
  8.     wl := Pointer(rtLockWindow(TheWindow));
  9.     tgs[0] := RT_IDCMPFlags;
  10.     tgs[1] := IDCMP_MOUSEBUTTONS|IDCMP_VANILLAKEY;
  11.     tgs[2] := RT_ReqPos;
  12.     tgs[3] := REQPOS_CENTERSCR;
  13.     tgs[4] := TAG_MORE;
  14.     tgs[5] := LONG(@t); 
  15.     ret := rtEZRequestA (CStrConstPtrAR(@RememberKey, InfoHead+ 
  16.         'Copyright ©1994-96 Lee Kindness.'#10 +
  17.         'wangi@frost3.demon.co.uk'#10 +
  18.         ''#10 +
  19.         'See "Startup-Menu.Guide" for more information.'#10#10),
  20.         CStrConstPtrAR(@RememberKey, 'Ok'), NIL, NIL, @tgs);
  21.     rtUnLockWindow(TheWindow, wl);
  22. end;
  23.  
  24. { Use Reqtools requesters to get screen/window title strings from the user }
  25. Procedure GetTitles;
  26.  
  27. VAR
  28.     buffer: String[128];
  29.     ret   : Long;
  30.     tags  : array [0..4] of tTagItem;
  31.  
  32. begin
  33.     wl := Pointer(rtLockWindow(TheWindow));
  34.     tags[0].ti_Tag  := RT_Window;
  35.     tags[0].ti_Data := LONG(TheWindow);
  36.     tags[1].ti_Tag  := RTGS_TextFmt;
  37.     tags[1].ti_Data := LONG(CStrConstPtrAR(@RememberKey, 'Enter the text to be displayed'+#10+' on the screen titlebar.'));
  38.     tags[2].ti_Tag  := RTGS_FLAGS;
  39.     tags[2].ti_Data := GSREQF_CENTERTEXT;
  40.     tags[3].ti_Tag  := TAG_END;
  41.  
  42.     buffer := CD.cd_ScrTit+#0;
  43.     ret := rtGetStringA (@buffer[1], 127, CStrConstPtrAR(@RememberKey, Win_Title), NIL, @tags);
  44.     if ret <> 0 then
  45.         CD.cd_ScrTit := PtrToPas(@Buffer[1]);
  46.  
  47.     buffer := CD.cd_WinTit+#0;
  48.     tags[1].ti_Data := LONG(CStrConstPtrAR(@RememberKey, 'Enter the text to be displayed'+#10+' on the window titlebar.'));
  49.     ret:=rtGetStringA (@buffer[1], 127, CStrConstPtrAR(@RememberKey, Win_Title), NIL, @tags);
  50.     if ret <> 0 then 
  51.         CD.cd_WinTit := PtrToPas(@buffer[1]);
  52.     rtUnLockWindow(TheWindow, wl);
  53. end;
  54.  
  55.  
  56. { Use Reqtools palette requester on a custom screen }
  57. { to get the users desired palette }
  58. Procedure GetPal;
  59.  
  60. CONST
  61.     MyPens : Array[0..8] of Word = ($FFFF); (* Get default *)
  62.  
  63. VAR
  64.     result : Long;
  65.     tags : array [0..10] of tTagItem;
  66.     TheScreen : pScreen;
  67.     win : pWindow;
  68.     ok : boolean;
  69.     MyTextFont : pTextFont;
  70.  
  71. begin
  72.     wl := Pointer(rtLockWindow(TheWindow));
  73.  
  74.     DiskFontBase  := Openlibrary('diskfont.library',36); 
  75.     If DiskFontBase <> NIL Then begin
  76.         MyTextFont := OpenDiskFont(@CD.cd_Font);
  77.         CloseLibrary(pLibrary(DiskFontBase));
  78.     end;
  79.  
  80.     tags[0].ti_Tag  := SA_Type;
  81.     tags[0].ti_Data := CUSTOMSCREEN;
  82.     tags[1].ti_Tag  := SA_Title;
  83.     tags[1].ti_Data := LONG(CStrConstPtrAR(@RememberKey, 'Change the palette'));
  84.     tags[2].ti_Tag  := SA_OverScan;
  85.     tags[2].ti_Data := OSCAN_TEXT;
  86.     tags[3].ti_Tag  := SA_Depth;
  87.     tags[3].ti_Data := 2;
  88.     tags[4].ti_Tag  := SA_Font;
  89.     tags[4].ti_Data := LONG(@CD.cd_Font);
  90.     tags[5].ti_Tag  := SA_DisplayID;
  91.     tags[5].ti_Data := CD.cd_ModeID; 
  92.     tags[6].ti_Tag  := SA_Width;
  93.     tags[6].ti_Data := STDSCREENWIDTH;
  94.     tags[7].ti_Tag  := SA_Height;
  95.     tags[7].ti_Data := STDSCREENHEIGHT;
  96.     tags[8].ti_Tag  := SA_Pens;
  97.     tags[8].ti_Data := LONG(@MyPens);
  98.     tags[9].ti_Tag  := SA_Colors;
  99.     tags[9].ti_Data := LONG(NIL);
  100.     tags[10].ti_Tag  := TAG_END;
  101.    
  102.     TheScreen := OpenScreenTagList(NIL, @tags);
  103.     IF TheScreen <> NIL then begin
  104.         LoadRGB4(@TheScreen^.ViewPort, @CD.cd_Pal[0], 4);
  105.     
  106.         tags[0].ti_Tag  := RT_Screen;
  107.         tags[0].ti_Data := LONG(TheScreen);
  108.         tags[1].ti_Tag  := TAG_END;
  109.  
  110.         result := rtPaletteRequestA (CStrConstPtrAR(@RememberKey, 'Change palette'), NIL, @tags);
  111.         if result <> -1 then begin
  112.             CD.cd_Pal[0] := GetRGB4(TheScreen^.ViewPort.ColorMap,0);
  113.             CD.cd_Pal[1] := GetRGB4(TheScreen^.ViewPort.ColorMap,1);
  114.             CD.cd_Pal[2] := GetRGB4(TheScreen^.ViewPort.ColorMap,2);
  115.             CD.cd_Pal[3] := GetRGB4(TheScreen^.ViewPort.ColorMap,3);
  116.         end;
  117.         ok := CloseScreen(TheScreen);
  118.     end;
  119.     CloseFont(MyTextFont);
  120.     rtUnLockWindow(TheWindow, wl);
  121. end;
  122.  
  123. { Use Reqtools Screenmode requester to get users screenmode }
  124. { and size preferences } 
  125. Function GetSCRID : LONG;
  126.  
  127. VAR
  128.     scrnreq : prtScreenModeRequester;
  129.     sreq    : pScreenModeRequester;
  130.     Value   : Longint;
  131.     ret     : longint;
  132.     mytag   : Array[0..10] of tTagItem;
  133.     UseAsl  : Boolean;
  134.  
  135. Begin
  136.     Value := CD.cd_ModeID;
  137.     UseAsl := False;
  138.     wl := Pointer(rtLockWindow(TheWindow));
  139.     If AslBase <> NIL then begin 
  140.         If AslBase^.lib_Version >= 38 then
  141.             UseAsl := True;
  142.     End;
  143.     If UseAsl then begin
  144.         MyTag[0].ti_Tag  := ASLSM_InitialDisplayID;
  145.         MyTag[0].ti_Data := CD.cd_ModeID;
  146.         MyTag[1].ti_Tag  := ASLSM_InitialDisplayWidth;
  147.         MyTag[1].ti_Data := CD.cd_ScrW;
  148.         MyTag[2].ti_Tag  := ASLSM_InitialDisplayHeight;
  149.         MyTag[2].ti_Data := CD.cd_ScrH;
  150.         MyTag[3].ti_Tag  := ASLSM_InitialDisplayDepth;
  151.         MyTag[3].ti_Data := CD.cd_ScrDepth; 
  152.         MyTag[4].ti_Tag  := ASLSM_DoWidth;
  153.         MyTag[4].ti_Data := True_;
  154.         MyTag[5].ti_Tag  := ASLSM_DoHeight;
  155.         MyTag[5].ti_Data := True_;
  156.         MyTag[6].ti_Tag  := ASLSM_DoDepth;
  157.         MyTag[6].ti_Data := True_;
  158.                                 (*
  159.                                  * MyTag[7].ti_Tag  := ASLSM_PropertyFlags;
  160.                                   * MyTag[7].ti_Data := 0;
  161.                                  * MyTag[8].ti_Tag  := ASLSM_PropertyMask;
  162.                                  * MyTag[8].ti_Data := DIPF_IS_PF2PRI|DIPF_IS_DUALPF;
  163.                                  *)
  164.         MyTag[9].ti_Tag  := ASLSM_Window;
  165.         MyTag[9].ti_Data := LONG(TheWindow);
  166.         MyTag[10].ti_Tag := TAG_END;
  167.         
  168.         sreq := AllocAslRequest(ASL_ScreenModeRequest,@MyTag);
  169.         if sreq <> NIL then begin
  170.             if AslRequest(sreq, NIL) then begin
  171.                 value          := sreq^.sm_DisplayID;
  172.                 CD.cd_ScrW     := sreq^.sm_DisplayWidth;
  173.                 CD.cd_ScrH     := sreq^.sm_DisplayHeight;
  174.                 CD.cd_ScrDepth := sreq^.sm_DisplayDepth;
  175.             End;
  176.             FreeAslRequest(sreq);
  177.         end;
  178.     end else begin 
  179.         scrnreq := Pointer(rtAllocRequestA (RT_SCREENMODEREQ, NIL));
  180.         if (scrnreq<>NIL) then begin
  181.             mytag[0].ti_Tag  := RTSC_DisplayID;
  182.             mytag[0].ti_Data := CD.cd_ModeID;
  183.             mytag[1].ti_Tag  := RTSC_DisplayHeight;
  184.             mytag[1].ti_Data := CD.cd_ScrH;
  185.             mytag[2].ti_Tag  := RTSC_DisplayWidth;
  186.             mytag[2].ti_Data := CD.cd_ScrW;
  187.             mytag[3].ti_Tag  := RTSC_DisplayDepth;
  188.             mytag[3].ti_Data := CD.cd_ScrDepth;
  189.             mytag[4].ti_Tag:=TAG_END;
  190.             ret := rtChangeReqAttrA(scrnreq, @mytag);
  191.  
  192.             mytag[0].ti_Tag  := RTSC_Flags;
  193.             mytag[0].ti_Data := SCREQF_SIZEGADS|SCREQF_DEPTHGAD|SCREQF_NONSTDMODES;
  194.             mytag[1].ti_Tag  := RT_UnderScore;
  195.             mytag[1].ti_Data := LongInt('_');
  196.             mytag[2].ti_Tag  := RT_Window;
  197.             mytag[2].ti_Data := LONG(TheWindow);
  198.             mytag[3].ti_Tag  := TAG_END;
  199.  
  200.             ret:=rtScreenModeRequestA ( scrnreq, CStrConstPtrAR(@RememberKey, 'Pick a screenmode'), @mytag);
  201.             value := LongInt(scrnreq^.DisplayID);
  202.             CD.cd_ScrW := LongInt(scrnreq^.DisplayWidth);
  203.             CD.cd_ScrH := LongInt(scrnreq^.DisplayHeight);
  204.             CD.cd_ScrDepth := LONG(scrnreq^.DisplayDepth);
  205.         end ;
  206.         rtFreeRequest(scrnreq);
  207.     end;
  208.     GetSCRID := value;
  209.     rtUnLockWindow(TheWindow, wl);
  210. end;
  211.  
  212. { move a node up to the of the list }
  213. Procedure TopGadFunc;
  214.  
  215. begin
  216.     if currentnode <> NIL then begin
  217.         DetachObjectList;
  218.         Remove(pNode(CurrentNode));
  219.         AddHead(CurrentList,pNode(CurrentNode));
  220.         CurrentOrd := 0; 
  221.         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  222.         currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  223.         else currenttop := 0;
  224.         AttachObjectList;
  225.     end;
  226. end;
  227.  
  228. { move a node up the list }
  229. Procedure UpGadFunc;
  230.  
  231. begin
  232.     pred := pMyNode(Currentnode^.LSK_Node.ln_Pred);
  233.     if (CurrentNode <> NIL) and (pred <> NIL) then begin
  234.         DetachObjectList;
  235.         (* Move node one position up *)
  236.         pred := pMyNode(pred^.LSK_Node.ln_Pred);
  237.         Remove(pNode(CurrentNode));
  238.         Insert_(CurrentList,pNode(CurrentNode),pNode(pred));
  239.         CurrentOrd := CurrentOrd - 1;
  240.         if currentord < 0 then currentord := 0;
  241.         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  242.             currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  243.         else 
  244.             currenttop := 0;
  245.         AttachObjectList;
  246.     end;
  247. end;
  248.  
  249. { move a node down the list }
  250. Procedure DownGadFunc;
  251.  
  252. begin
  253.     succ := pMyNode(currentnode^.LSK_Node.ln_Succ);
  254.     if (CurrentNode <> NIL) and (succ <> NIL) then begin
  255.         DetachObjectList;
  256.         Remove(pNode(CurrentNode));
  257.         Insert_(CurrentList,pNode(CurrentNode),pNode(succ));
  258.         Currentord := currentord + 1;
  259.         i := 0;
  260.         tmpnode := pMyNode(currentlist^.lh_Head);
  261.         While tmpnode <> NIL do begin
  262.             i := i + 1;
  263.             tmpnode := pMyNode(tmpnode^.LSK_Node.ln_Succ);
  264.         end;
  265.         i := i-2;
  266.         if currentord > i then currentord := i;
  267.         if currentord < 0 then currentord := 0;
  268.         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  269.             currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  270.         else 
  271.             currenttop := 0;
  272.         AttachObjectList;
  273.     end;
  274. end;
  275.  
  276. { move a node to the bottom of the list }
  277. Procedure BottomGadFunc;
  278.  
  279. begin
  280.     if currentnode <> NIL then begin
  281.         DetachObjectList;
  282.         Remove(pNode(CurrentNode));
  283.         AddTail(CurrentList,pNode(CurrentNode));
  284.         tmpnode := pMyNode(currentlist^.lh_Head);
  285.         i := 0;
  286.         while tmpnode <> NIL do begin
  287.             tmpnode := pMyNode(tmpnode^.LSK_Node.ln_Succ);
  288.             i := i + 1;
  289.         end;
  290.         CurrentOrd := i - 2;
  291.         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  292.             currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  293.         else 
  294.             currenttop := 0;
  295.         AttachObjectList;
  296.     end;
  297. end;
  298.  
  299. { add a new node to the list }
  300. Procedure NewGadFunc;
  301.  
  302. VAR
  303.     Changed : Boolean;
  304.  
  305. begin
  306.     DetachObjectList;
  307.     tmpnode := Add_Name('<< New Gadget >>');
  308.     changed := GadEDWindow(TheWindow^.LeftEdge+5, TheWindow^.TopEdge+Sizes[TBS], 
  309.         tmpnode, CD.cd_Rexx);
  310.  
  311.     if changed then begin
  312.         CurrentNode := tmpnode;
  313.         currentnode^.LSK_Node.ln_Name := @currentnode^.LSK_Name[1];
  314.         CurrentOrd := 0;
  315.         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  316.             currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  317.         else 
  318.             currenttop := 0;
  319.         DisableObjectGadgets(False_);
  320.     end else begin
  321.         Remove(pNode(tmpnode));
  322.     end;
  323.     CD.cd_Down := calcdown(CD.cd_Across, NIL, NIL);
  324.     AttachObjectList;
  325. end;
  326.  
  327. { remove a gadget node from the list }
  328. Procedure RemoveGadFunc;
  329.  
  330. begin
  331.     if currentnode <> NIL then begin
  332.         DetachObjectList;
  333.         DisableObjectGadgets(TRUE_);
  334.         Remove(pNode(CurrentNode));
  335.         CurrentNode := NIL;
  336.         CurrentOrd := -1;
  337.         currenttop := 0;
  338.         AttachObjectList;
  339.     end;
  340.     CD.cd_Down := calcdown(CD.cd_Across, NIL, NIL);
  341. end;
  342.  
  343. { copy a gadget node }
  344. Procedure CopyGadFunc;
  345.  
  346. begin
  347.     if (CurrentNode <> NIL) then begin
  348.         DetachObjectList;
  349.         newnode := AllocRemember(@RememberKey, sizeof(tMyNode), MEMF_CLEAR);
  350.         newnode^ := CurrentNode^;
  351.         (* Correct pointers *)
  352.         newnode^.LSK_Node.ln_Name := @newnode^.LSK_Name[1];
  353.         if newnode <> NIL then begin
  354.             Insert_(CurrentList,pNode(newnode),pNode(CurrentNode));
  355.             CurrentNode := newnode;
  356.             CurrentOrd := CurrentOrd + 1;
  357.             if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  358.                 currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  359.             else 
  360.                 currenttop := 0;
  361.         end;
  362.         AttachObjectList;
  363.     end;
  364.     CD.cd_Down := calcdown(CD.cd_Across, NIL, NIL);
  365. end;
  366.  
  367. { save the prefs file as s:startup-menu.prefs }
  368. Procedure SaveGadFunc;
  369.  
  370. VAR 
  371. l, l2 : BPTR;
  372.  
  373. begin
  374.     wl := Pointer(rtLockWindow(TheWindow));
  375.     DetachObjectList;
  376.     l2 := Lock(CStrConstPtrAR(@RememberKey, PrefsDIRH), ACCESS_READ);
  377.     l := currentdir(l2);
  378.     IF NOT WriteConfigFile(PREFSNAME) then DisplayBeep(NIL);
  379.     AttachObjectList;
  380.     l := currentdir(l);
  381.     unlock(l2);
  382.     AttachObjectList;
  383.     rtUnLockWindow(TheWindow, wl);
  384.     exitflag := True;
  385. end;
  386.  
  387. { save prefs file in user specified location }
  388. Procedure SaveAsGadFunc;
  389.  
  390. VAR 
  391. l, l2 : BPTR;
  392.  
  393. begin
  394.     wl := Pointer(rtLockWindow(TheWindow));
  395.     if AslRequest(sr, NIL) then begin
  396.         DetachObjectList;
  397.         l2 := Lock(STRPTR(sr^.fr_Drawer), ACCESS_READ);
  398.         l := currentdir(l2);
  399.         cfile := PtrToPas(STRPTR(sr^.fr_file));
  400.         IF NOT WriteConfigFile(cfile) then DisplayBeep(NIL);
  401.         l := currentdir(l); 
  402.         unlock(l2);
  403.         AttachObjectList;
  404.     end;
  405.     rtUnLockWindow(TheWindow, wl);
  406. end;
  407.  
  408. Procedure NewListFunc;
  409.  
  410. Begin
  411.     wl := Pointer(rtLockWindow(TheWindow));
  412.     DetachObjectList;
  413.     (* Start a' fresh *)
  414.     CurrentList := AllocRemember(@RememberKey, sizeof(tList), MEMF_CLEAR);
  415.     NewList(CurrentList);
  416.     InitCD;
  417.     CurrentNode := NIL;
  418.     CurrentOrd := -1;
  419.     currenttop := 0;
  420.     DisableObjectGadgets(TRUE_);
  421.     AttachObjectList; 
  422.     rtUnLockWindow(TheWindow, wl);
  423. end;
  424.  
  425. { load a new prefs file }
  426. Procedure LoadGadFunc;
  427.  
  428. VAR 
  429.     l, l2 : BPTR;
  430.  
  431. Begin
  432.     wl := Pointer(rtLockWindow(TheWindow));
  433.     if AslRequest(lr, NIL) then begin
  434.         DetachObjectList;
  435.                
  436.         l2 := Lock(STRPTR(lr^.fr_Drawer), ACCESS_READ);
  437.         l := currentdir(l2);
  438.                
  439.         cfile := PtrToPas(STRPTR(lr^.fr_file));
  440.  
  441.         OKRes := ReadConfigFile(cfile);
  442.         if OKRes then begin  
  443.             CurrentNode := NIL;
  444.             CurrentOrd := -1;
  445.             currenttop := 0;
  446.             DisableObjectGadgets(TRUE_);
  447.         end else DisplayBeep(NIL);
  448.  
  449.         AttachObjectList; 
  450.  
  451.         l := currentdir(l);
  452.         unlock(l2);
  453.     end; 
  454.     rtUnLockWindow(TheWindow, wl);
  455. end;
  456.                
  457. { if double click on LV then bring up the gadget edit window }
  458. Procedure LVGadFunc;
  459.  
  460. VAR 
  461.     y    : integer;
  462.     junk : Boolean;
  463.  
  464. Begin
  465.     oldord := currentord;
  466.     CurrentOrd := msgCode;
  467.     if currentord < 0 then currentord := 0;
  468.     if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  469.         currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  470.     else 
  471.         currenttop := 0;
  472.     CurrentNode := pMyNode(CurrentList^.lh_Head);
  473.     For y := 1 to currentord do
  474.         CurrentNode := pMyNode(CurrentNode^.LSK_Node.ln_Succ);
  475.  
  476.     (* Double Click? *)
  477.     if (DoubleClick(CurrentSecs, CurrentMics, NewSecs, NewMics)) and
  478.     (currentord = oldord) then begin
  479.         wl := Pointer(rtLockWindow(TheWindow));
  480.         detachobjectlist;
  481.         junk := GadEDWindow(TheWindow^.LeftEdge+5, TheWindow^.TopEdge+Sizes[TBS], 
  482.         currentnode, CD.cd_Rexx);
  483.         currentnode^.LSK_Node.ln_Name := @currentnode^.LSK_Name[1];
  484.         attachobjectlist;
  485.         rtUnLockWindow(TheWindow, wl);
  486.     end; 
  487.  
  488.     currentSecs := NewSecs;
  489.     CurrentMics := NewMics;
  490.  
  491.     DisableObjectGadgets(False_);
  492. end;
  493.  
  494.  
  495. { requester alowing user to pick a font }
  496. Procedure FontGadFunc(Scroll : Boolean);
  497.  
  498. VAR
  499.     tgs : Array[0..7] of tTagItem;
  500.     fr  : pFontRequester;
  501.  
  502. begin
  503.     tgs[0].ti_Tag  := ASLFO_TitleText;
  504.     tgs[1].ti_Tag  := ASLFO_InitialName;
  505.     tgs[2].ti_Tag  := ASLFO_InitialSize;
  506.     tgs[3].ti_Tag  := ASLFO_MaxHeight;
  507.     tgs[3].ti_Data := 100;
  508.     tgs[4].ti_Tag  := ASLFO_Flags;
  509.     tgs[4].ti_Data := FOF_DOSTYLE;
  510.     if Scroll then begin
  511.         tgs[0].ti_Data := LONG(CStrConstPtrAR(@RememberKey, 'Pick a font for the scrolling text'));
  512.         tgs[1].ti_Data := LONG(CD.cd_SFont.ta_Name);
  513.         tgs[2].ti_Data := long(CD.cd_SFont.ta_YSize);
  514.         tgs[4].ti_Data := tgs[4].ti_Data|FOF_FIXEDWIDTHONLY;
  515.     end else begin
  516.         tgs[0].ti_Data := LONG(CStrConstPtrAR(@RememberKey, 'Pick a font for the gadgets'));
  517.         tgs[1].ti_Data := LONG(CD.cd_Font.ta_Name);
  518.         tgs[2].ti_Data := long(CD.cd_Font.ta_YSize);
  519.     end;
  520.     tgs[5].ti_Tag  := ASLFO_Window;
  521.     tgs[5].ti_Data := long(TheWindow);
  522.     tgs[6].ti_Tag  := ASLFO_InitialStyle;
  523.     tgs[6].ti_Data := long(CD.cd_Font.ta_Style);
  524.     tgs[7].ti_Tag  := TAG_DONE;
  525.     fr := AllocASLRequest(ASL_FontRequest, @tgs);
  526.     if fr <> NIL then begin
  527.         wl := Pointer(rtLockWindow(TheWindow));
  528.         if AslRequest(fr, @tgs) then begin
  529.             if Scroll then begin
  530.                 CD.cd_SFont := fr^.fo_Attr;
  531.                 CD.cd_SFontName := PtrToPas(fr^.fo_Attr.ta_NAME)+#0;
  532.                 CD.cd_SFont.ta_NAME := @CD.cd_SFontName[1];
  533.             end else begin
  534.                 CD.cd_Font := fr^.fo_Attr;
  535.                 CD.cd_FontName := PtrToPas(fr^.fo_Attr.ta_NAME)+#0;
  536.                 CD.cd_Font.ta_NAME := @CD.cd_FontName[1];
  537.             end;  
  538.         end;
  539.         rtUnLockWindow(TheWindow, wl);
  540.         FreeAslRequest(fr);
  541.     end;
  542. end;
  543.  
  544. { 'run' Startup-Menu with the current prefs file in memory as arguments }
  545. Procedure TestGadFunc;
  546.  
  547. VAR
  548.     ts       : String;
  549.     OldFlush : Boolean;
  550.     
  551. Begin
  552.     begin
  553.         wl := Pointer(rtLockWindow(TheWindow));
  554.         ts := CD.cd_ScrTit;
  555.         OldFlush := CD.cd_Flush;
  556.         CD.cd_Flush := False;
  557.         CD.cd_Test := True;
  558.         CD.cd_ScrTit := CD.cd_ScrTit + ' ...TESTING-CMD NOT RUN ON BUTTON DEPRESS';
  559.         IF WriteConfigFile('RAM:SMPrefs.TMP') then begin
  560.             if NOT Execsynch(STRPTR(CStrConstPtrAR(@RememberKey, 'Startup-Menu RAM:SMPrefs.TMP'))) then
  561.                 DisplayBeep(NIL);
  562.  
  563.             Erase('RAM:SMPrefs.TMP');
  564.         end;
  565.         CD.cd_ScrTit := ts;
  566.         CD.cd_Flush := OldFlush;
  567.         CD.cd_Test := False;
  568.         
  569.         rtUnLockWindow(TheWindow, wl);
  570.     end;
  571. end;